home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / demos / 26 / pascal / cube.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-06-19  |  5.5 KB  |  248 lines
  1. PROGRAM Cube;      { Author: William P. Smith  }
  2.                    {         Mitchellville, Md }
  3.  
  4.                    { This is a real time graphics demo of a cube tumbling in }
  5.                    { 3-space.   The 8088 processor is just too slow to do    }
  6.                    { effectively demonstrate real time graphics, but this    }
  7.                    { program can be used as a bench mark for graphics        }
  8.                    { performance of future generation PCs.                   }
  9.  
  10. {
  11.  05/20/86
  12.  Converted form Turbo Pascal For I.B.M. PCs to O.S.S. Personal Pascal
  13.  By Jerry LaPeer of LaPeer Systems Inc.
  14.  Uses 2 screens of memory and swaps them for smooth animation
  15.  
  16.  Well the 8088 on the PCs may be slow but the ST is at the least
  17.  fast enough
  18. }
  19.  
  20. CONST
  21.   Pi    = 3.1415927;
  22.  
  23. {$I GEMCONST.PAS}
  24.  
  25. TYPE
  26.  
  27.   Screendef =   ^Screendata;
  28.   Screendata =  PACKED ARRAY[1..32766] OF CHAR;
  29.  
  30. {$I gemtype.pas}    { Note That CASE Doesn'T Matter }
  31.  
  32. VAR
  33.   A,B,Ax,Bx,Ay,By,Az,Bz,Th,Thx,Thy,Thz: REAL;
  34.   T:     ARRAY[1..3,1..3] OF REAL;
  35.   Scale: REAL;
  36.   Incrs: REAL;
  37.   Xp,Yp: ARRAY[1..3] OF INTEGER;
  38.   X,Y:   ARRAY[1..7] OF INTEGER;
  39.   J:     INTEGER;
  40.   Offsetx,Offsety,Hoffsetx,Hoffsety: INTEGER;
  41.   Incrx,Incry: INTEGER;
  42.   Color_Off,Color_On:   INTEGER;
  43.   Reply:        Str255;
  44.  
  45.   Curlogbase:   Screendef;
  46.   Curphybase:   Screendef;
  47.  
  48.   Visible_Screen:Screendef;
  49.   Build_Screen: Screendef;
  50.  
  51.   Screen1:      Screendef;
  52.   Screen2:      Screendef;
  53.  
  54. {$I gemsubs}          { AND That ".Pas" Is Default }
  55.  
  56. FUNCTION Getphybase : Screendef;
  57. Xbios(2);
  58.  
  59. FUNCTION Getlogbase : Screendef;
  60. Xbios(3);
  61.  
  62. PROCEDURE Setscreen(Logloc,Phyloc : Screendef;
  63.                     Rez : INTEGER);
  64. Xbios(5);
  65.  
  66. PROCEDURE Draw(X1,Y1,X2,Y2,Lc : INTEGER);
  67.  
  68. BEGIN
  69.  
  70.   Line_Color(Lc);
  71.  
  72.   Line(X1,Y1,X2,Y2);
  73.  
  74. END;
  75.  
  76. PROCEDURE Drawcube(Thx,Thy,Thz: REAL);
  77.  
  78. VAR
  79.   I,J:          INTEGER;
  80.   Tempscreen:   Screendef;
  81.  
  82. BEGIN
  83.  
  84.   Az:=COS(Thz) / Scale;
  85.   Ax:=COS(Thx) / Scale;
  86.   Ay:=COS(Thy) / Scale;
  87.  
  88.   Bz:=SIN(Thz) / Scale;
  89.   Bx:=SIN(Thx) / Scale;
  90.   By:=SIN(Thy) / Scale;
  91.  
  92.   T[1,1]:=Az*Ay-Bx*By*Bz;  T[1,2]:=-Bz*Ax;  T[1,3]:=Az*By+Ay*Bz*Bx;
  93.   T[2,1]:=Bz*Ay+Az*Bx*By;  T[2,2]:=Az*Ax;   T[2,3]:=Bz*By-Az*Ay*Bx;
  94.   T[3,1]:=-Ax*By;          T[3,2]:=Bx;      T[3,3]:=Ax*Ay;
  95.  
  96.   FOR J:=1 TO 3 DO BEGIN
  97.     Xp[J]:=ROUND(60*(T[2,J]-T[1,J]*B));
  98.     Yp[J]:=ROUND(30*(T[3,J]-T[1,J]*A));
  99.   END;
  100.  
  101.   X[1]:=Offsetx+Xp[1];               Y[1]:=Offsety-Yp[1];
  102.   X[2]:=X[1]+Xp[2];                  Y[2]:=Y[1]-Yp[2];
  103.   X[3]:=Offsetx+Xp[2];               Y[3]:=Offsety-Yp[2];
  104.   X[4]:=X[3]+Xp[3];                  Y[4]:=Y[3]-Yp[3];
  105.   X[5]:=Offsetx+Xp[3];               Y[5]:=Offsety-Yp[3];
  106.   X[6]:=X[1]+Xp[3];                  Y[6]:=Y[1]-Yp[3];
  107.   X[7]:=X[2]+Xp[3];                  Y[7]:=Y[2]-Yp[3];
  108.  
  109.   Draw(Offsetx,Offsety,X[1],Y[1],Color_On);
  110.   Draw(X[1],Y[1],X[2],Y[2],Color_On);
  111.   Draw(X[2],Y[2],X[3],Y[3],Color_On);
  112.   Draw(X[3],Y[3],X[4],Y[4],Color_On);
  113.   Draw(X[4],Y[4],X[5],Y[5],Color_On);
  114.   Draw(X[5],Y[5],X[6],Y[6],Color_On);
  115.   Draw(X[6],Y[6],X[7],Y[7],Color_On);
  116.   Draw(X[7],Y[7],X[4],Y[4],Color_On);
  117.   Draw(X[3],Y[3],Offsetx,Offsety,Color_On);
  118.   Draw(Offsetx,Offsety,X[5],Y[5],Color_On);
  119.   Draw(X[6],Y[6],X[1],Y[1],Color_On);
  120.   Draw(X[7],Y[7],X[2],Y[2],Color_On);
  121.  
  122.   Tempscreen := Visible_Screen;
  123.   Visible_Screen := Build_Screen;
  124.   Build_Screen := Tempscreen;
  125.  
  126.   Setscreen(Build_Screen,Visible_Screen,-1);
  127.  
  128.   Clear_Screen;
  129.  
  130. END;
  131.  
  132. PROCEDURE Beep;
  133.  
  134. BEGIN
  135.  
  136.   WRITE(CHR($07));
  137.  
  138.   Color_On := Color_On + 1;
  139.  
  140.   IF NOT (Color_On IN [1..3])
  141.     THEN Color_On := 1;
  142.  
  143. END;
  144.  
  145. PROCEDURE Do_Main;
  146.  
  147. VAR
  148.   Delay_Count:          INTEGER;
  149.   I:                    INTEGER;
  150.   Creply:               CHAR;
  151.  
  152. BEGIN
  153.  
  154.   Th:=Pi/4;
  155.  
  156.   A:=COS(Th); B:=SIN(Th);
  157.  
  158.   Offsetx:=300; Offsety:=100; Scale := 1.0;
  159.  
  160.   Incrx:=5; Incry:=3; Incrs := 0.02;
  161.  
  162.   Thx:=0.0; Thy:=0.0; Thz:=0.0;
  163.  
  164.   Color_Off := 0;
  165.   Color_On := 1;
  166.  
  167.   Drawcube(Thx,Thy,Thz);
  168.  
  169.   REPEAT
  170.  
  171.     Thz:=Thz+0.1; Thx:=Thx-0.1; Thy:=Thy+0.1;
  172.  
  173.     Drawcube(Thx,Thy,Thz);
  174.  
  175.     IF (Offsetx >= 500) OR (Offsetx <= 40)
  176.       THEN BEGIN
  177.         Incrx:=-Incrx;
  178.         Beep;
  179.       END;
  180.  
  181.     IF (Offsety <= 50) OR (Offsety >= 150)
  182.       THEN BEGIN
  183.         Incry:=-Incry;
  184.         Beep;
  185.       END;
  186.  
  187.     Scale := Scale + Incrs;
  188.  
  189.     IF Scale >= 3.0
  190.       THEN Incrs := -Incrs
  191.       ELSE IF Scale <= 0.5
  192.              THEN Incrs := -Incrs;
  193.  
  194.     Offsetx:=Offsetx+Incrx; Offsety:=Offsety+Incry;
  195.  
  196.   UNTIL Keypress;
  197.  
  198.   READ(Creply);
  199.  
  200. END;
  201.  
  202. FUNCTION Alloc_Screen : Screendef;
  203.  
  204. CONST
  205.   Scraddrresolution = 256;
  206.  
  207. VAR
  208.   Scrjunk:      RECORD
  209.     CASE Byte OF
  210.       0 : (Sali:       Long_Integer);
  211.       1 : (Sa:         Screendef);
  212.   END;
  213.  
  214. BEGIN
  215.  
  216.   WITH Scrjunk DO BEGIN
  217.     NEW(Sa);
  218.     IF Sali MOD Scraddrresolution <> 0
  219.       THEN Sali := Sali + (Scraddrresolution - (Sali MOD Scraddrresolution));
  220.   END;
  221.  
  222.   Alloc_Screen := Scrjunk.Sa;
  223.  
  224. END;
  225.  
  226. BEGIN
  227.  
  228.   IF Init_Gem >= 0
  229.     THEN BEGIN
  230.       Curlogbase := Getlogbase;
  231.       Curphybase := Getphybase;
  232.       Screen1 := Alloc_Screen;
  233.       Screen2 := Alloc_Screen;
  234.       Setscreen(Screen1,Curphybase,-1);
  235.       Clear_Screen;
  236.       Setscreen(Screen2,Curphybase,-1);
  237.       Clear_Screen;
  238.       Visible_Screen := Screen2;
  239.       Build_Screen := Screen1;
  240.       Setscreen(Build_Screen,Visible_Screen,-1);
  241.       Set_Clip(0,0,640,200);
  242.       Do_Main;
  243.       Setscreen(Curlogbase,Curphybase,-1);
  244.       Exit_Gem;
  245.     END;
  246.  
  247. END.